CD Actual Thematic 25: Programming/pc_actual_25.iso/Delphi/MP3 Blade Encoder Component 1.0/MMBLADE.PAS

Pascal/Delphi Source File | 1999-05-06 | 16.3 KB | 522 lines

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]              =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 19.03.99 - 18:54:27 $                                        =}
{========================================================================}
unit MMBlade;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinTypes,
  WinProcs,
{$ENDIF}
  SysUtils,
  Classes,
  Controls,
  Dialogs,
  MMSystem,
  MMRegs,
  MMObj,
  MMDSPobj,
  MMUtils,
  MMWave,
  BladeEnc;

type
    TMMChannelMode = (cmStereo, cmDualChannel, cmMono);
    TMMBitrates    = (br32,br40,br48,br56,br64,br80,br96,br112,
                      br128,br160,br192,br224,br256,br320);
    TMMFileType    = (ftWAV,ftRAW);

    {-- TMMMP3Encoder ---------------------------------------------------------}
    TMMMP3Encoder  = class(TMMDSPComponent)
    private
       FWave       : TMMWave;
       FHandle     : integer;
       FOpen       : Boolean;
       FStarted    : Boolean;
       FFileName   : string;
       FChannelMode: TMMChannelMode;
       FBitrate    : TMMBitrates;
       FCopyright  : Boolean;
       FPrivate    : Boolean;
       FCRC        : Boolean;
       FOriginal   : Boolean;
       FInSamples  : DWORD;
       FInBufSize  : DWORD;
       FInBuffer   : PChar;
       FOutBufSize : DWORd;
       FOutBuffer  : PChar;
       FBytesQueued: Longint;
       FHStream    : HBE_STREAM;
       FFileType   : TMMFileType;

       procedure SetFileName(aValue: string);
       procedure SetFileType(aValue: TMMFileType);

       function  _CreateFile: Boolean;
       procedure _CloseFile;
       function  _WriteFile(Buffer: PChar; nBytes: Longint): Boolean;

    protected
       procedure Opened; override;
       procedure Closed; override;
       procedure Started; override;
       procedure Stopped; override;
       procedure BufferReady(lpwh: PWaveHdr); override;

    public
       constructor Create(aOwner: TComponent); override;
       destructor  Destroy; override;

    published
       property Input;
       property ChannelMode: TMMChannelMode read FChannelMode write FChannelMode default cmStereo;
       property Bitrate: TMMBitrates read FBitrate write FBitrate default br128;
       property Copyright: Boolean read FCopyright write FCopyright default False;
       property Privat: Boolean read FPrivate write FPrivate default False;
       property CRC: Boolean read FCRC write FCRC default False;
       property Original: Boolean read FOriginal write FOriginal default False;
       property FileName: string read FFileName write SetFileName;
       property FileType: TMMFileType read FFileType write SetFileType default ftRAW;
    end;

procedure Register;

implementation

const
   CM : array[0..2] of Word = (BE_MP3_MODE_STEREO,BE_MP3_MODE_DUALCHANNEL,BE_MP3_MODE_MONO);
   BR : array[TMMBitrates] of Word = (32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320);

procedure Register;
begin
   RegisterComponents('MMWave', [TMMMP3Encoder]);
end;

{========================================================================}
function acmBuildMP3Header(SampleRate, Bitrate, Channels: integer): PWaveFormatEx;
const
    MP3Ext: array[0..11] of Byte = ($01,$00,$02,$00,$00,$00,$00,$00,$01,$00,$71,$05);
var
    BlockAlign: Double;
begin
    Result := GlobalAllocMem(sizeOf(TWaveFormatEx)+12);
    with Result^ do
    begin
       wFormatTag     := WAVE_FORMAT_MPEG_LAYER3;
       nChannels      := Channels;
       nSamplesPerSec := SampleRate;
       wBitsPerSample := 0;
       nBlockAlign    := 1;
       BlockAlign     := (144 * BitRate) / SampleRate;
       nAvgBytesPerSec:= Round((((SampleRate*100) / 1152)*BlockAlign) / 100);
       cbSize         := sizeOf(MP3Ext);
       GlobalMoveMem(MP3Ext,(PChar(Result)+sizeOf(TWaveFormatEx))^,sizeOf(MP3Ext));
       PWord(PChar(Result)+sizeOf(TWaveFormatEx)+6)^ := Trunc(BlockAlign);
    end;
end;

{== TMMMP3Encoder =============================================================}
constructor TMMMP3Encoder.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FHandle      := 0;
   FFileName    := '';
   FOpen        := False;
   FBitrate     := br128;
   FChannelMode := cmStereo;
   FCopyright   := False;
   FPrivate     := False;
   FCRC         := False;
   FOriginal    := False;
   FOutBuffer   := nil;
   FInBuffer    := nil;
   FFileType    := ftRAW;

   FWave        := TMMWave.Create;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
destructor TMMMP3Encoder.Destroy;
begin
   Closed;

   FWave.Free;

   inherited Destroy;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMp3Encoder.SetFileName(aValue: string);
begin
   if (aValue <> FFileName) then
   begin
      if FOpen then
         raise Exception.Create(LoadResStr(IDS_PROPERTYOPEN));
      FFileName := aValue;
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMp3Encoder.SetFileType(aValue: TMMFileType);
begin
   if (aValue <> FFileType) then
   begin
      if FOpen then
         raise Exception.Create(LoadResStr(IDS_PROPERTYOPEN));
      FFileType := aValue;
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
function TMMMP3Encoder._CreateFile;
var
   pwfx: PWaveFormatEx;

begin
   if (FFileType = ftRAW) then
   begin
      FHandle := FileCreate(FFileName);
      Result := (FHandle > 0);
   end
   else
   begin
      try
         pwfx := acmBuildMP3Header(PWaveFormat.nSamplesPerSec, BR[FBitrate]*1000, PWaveFormat.nChannels);
         try
            FWave.CreateFile(FFileName,Pointer(pwfx));
         finally
            GlobalFreeMem(Pointer(pwfx));
         end;
         Result := True;
      except
         Result := False;
      end;
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMP3Encoder._CloseFile;
begin
   if (FFileType = ftRAW) then
   begin
      FileClose(FHandle);
      FHandle := -1;
   end
   else
   begin
      FWave.CloseFile;
      FWave.FreeWave;
   end;
end;

var
   _GetDiskFreeSpaceEx: function (Directory: PChar; var FreeAvailable,
                                  TotalSpace: Int64;
                                  TotalFree: PInt64): Bool stdcall = nil;

{ This function is used if the OS doesn't support GetDiskFreeSpaceEx }
{-- TMMMP3Encoder -------------------------------------------------------------}
function BackfillGetDiskFreeSpaceEx(Directory: PChar; var FreeAvailable,
                                    TotalSpace: Int64;
                                    TotalFree: PInt64): Bool; stdcall;
var
  SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters: DWORD;
  Temp: Int64;
  Dir : PChar;
begin
  if Directory <> nil then
     Dir := PChar(ExtractFileDrive(Directory)+'\')
  else
     Dir := nil;

  Result := GetDiskFreeSpace(Dir, SectorsPerCluster, BytesPerSector,
                              FreeClusters, TotalClusters);
  Temp := SectorsPerCluster * BytesPerSector;
  FreeAvailable := Temp * FreeClusters;
  TotalSpace    := Temp * TotalClusters;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
function GetDiskStats(const Directory: string; var nFree, nSize: Int64): Boolean;
begin
   Result := _GetDiskFreeSpaceEx(PChar(ExtractFileDir(Directory)),nFree, nSize, nil);
   if not Result then
   begin { avoid errors from unchecked divisions }
      nFree := 0;
      nSize := 1;
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
function GetDiskFree(const Directory: string; nBytes: Longint): Boolean;
var
   nFree,nSize: Int64;
begin
   Result := False;
   if GetDiskStats(Directory,nFree,nSize) then
      Result := nFree >= nBytes;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
function TMMMP3Encoder._WriteFile(Buffer: PChar; nBytes: Longint): Boolean;
begin
   Result := GetDiskFree(FFileName,nBytes+10240);
   if not Result then exit;

   if (FFileType = ftRAW) then
   begin
      Result := (FileWrite(FHandle,Buffer^,nBytes) = nBytes);
   end
   else
   begin
      Result := (FWave.WriteDataBytes(Buffer,nBytes) = nBytes);
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMP3Encoder.Opened;
var
   Config: TBE_CONFIG;
begin
   inherited Opened;

   if not FOpen and (PWaveFormat <> nil) then
   begin
      if (Input <> nil) then
      begin{ we are a Output port }

         { we should save anything to the file, create it }
         if (FFileName <> '') then
         begin
            if not RequestDLLLoading then
                raise Exception.Create('Unable to load Blade Encoder DLL'#10#13+
                                       'You can download the BladeEncoder at:'#10#13+
                                       'http://home8.swipnet.se/~w-82625/encoder/binaries/BladeDLL075.zip');

            if (PWaveFormat.wFormatTag <> WAVE_FORMAT_PCM) or
               (PWaveFormat.wBitsPerSample <> 16) or
               ((PWaveFormat.nSamplesPerSec <> 48000) and
                (PWaveFormat.nSamplesPerSec <> 44100) and
                (PWaveFormat.nSamplesPerSec <> 32000)) then
                raise Exception.Create('Unsupported Input Format');

            with Config,Config.MP3 do
            begin
               dwConfig     := BE_CONFIG_MP3;
               dwSampleRate := PWaveFormat.nSamplesPerSec;
               if PWaveFormat.nChannels = 1 then
                  byMode    := BE_MP3_MODE_MONO
               else if (FChannelMode = cmMono) then
                  bymode    := BE_MP3_MODE_STEREO
               else
                  byMode    := CM[Ord(FChannelMode)];
               wBitrate     := BR[FBitrate];
               bPrivate     := FPrivate;
               bCRC         := FCRC;
               bCopyright   := FCopyright;
               bOriginal    := FOriginal;
            end;

            DeleteFile(FFileName);
            if not _CreateFile then
               raise Exception.Create('Unable to create file');

            if (beInitStream(@Config,FInSamples,FOutBufSize,FHStream) <> 0) then
                raise Exception.Create('Unable to initialize stream');

            FInBufSize   := FInSamples*2;
            FOutBuffer   := GlobalAllocMem(FOutBufSize);
            FInBuffer    := GlobalAllocMem(FInBufSize);
            FBytesQueued := 0;

            FOpen := True;
         end;
      end;
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMP3Encoder.Closed;
begin
   if FOpen then
   begin
      Stopped;
      _CloseFile;
      if (FHStream <> 0) then
      begin
         beCloseStream(FHStream);
         FHStream := 0;
      end;
      GlobalFreeMem(Pointer(FOutBuffer));
      GlobalFreeMem(Pointer(FInBuffer));
      FOpen := False;
   end;

   inherited Closed;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMP3Encoder.Started;
begin
   inherited Started;

   if not FStarted and FOpen then
   begin
      FStarted     := True;
      FBytesQueued := 0;
   end;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMP3Encoder.Stopped;
var
   nEncoded: DWORD;
begin
   if FOpen and FStarted then
   begin
      FStarted := False;

      if (FBytesQueued > 0) then
      begin
         if (beEncodeChunk(FHStream, FBytesQueued div 2, FInBuffer, FOutBuffer, nEncoded) <> 0) then
             raise Exception.Create('Unable to encode data');

         if (nEncoded > 0) then
         begin
            if not _WriteFile(FOutBuffer,nEncoded) then
            begin
               Closed;
               exit;
            end;
         end;
         dec(FBytesQueued,FInBufSize);
      end;

      if (beDeinitStream(FHStream,FOutBuffer,nEncoded) <> 0) then
          raise Exception.Create('Unable to deinitialize stream');

      if (nEncoded > 0) then
      begin
         if not _WriteFile(FOutBuffer,nEncoded) then
         begin
            Closed;
            exit;
         end;
      end;
   end;

   inherited Stopped;
end;

{-- TMMMP3Encoder -------------------------------------------------------------}
procedure TMMMP3Encoder.BufferReady(lpwh: PWaveHdr);
var
   n,nBytes,nRead,nEncoded: DWORD;
begin
   if FStarted and (Input <> nil) then
   begin
      { save the data to file (if any) }
      if (FFileName <> '') and (lpwh^.dwBytesRecorded > 0) then
      begin
         nBytes := lpwh^.dwBytesRecorded;
         nRead  := 0;

         if (FBytesQueued > 0) then
         begin
            n := Min(FInBufSize-FBytesQueued,nBytes);
            Move(lpwh^.lpData^,(FInBuffer+FBytesQueued)^,n);
            inc(FBytesQueued,n);

            inc(nRead,n);
            dec(nBytes,n);

            if (FBytesQueued >= FInBufSize) then
            begin
               if (beEncodeChunk(FHStream, FInSamples, FInBuffer, FOutBuffer, nEncoded) <> 0) then
                   raise Exception.Create('Unable to encode data');

               if (nEncoded > 0) then
               begin
                  if not _WriteFile(FOutBuffer,nEncoded) then
                  begin
                     Closed;
                     exit;
                  end;
               end;
               dec(FBytesQueued,FInBufSize);
            end;
         end;

         while (nBytes >= FInBufsize) do
         begin
            if (beEncodeChunk(FHStream, FInSamples, Pointer(lpwh^.lpData+nRead), FOutBuffer, nEncoded) <> 0) then
                raise Exception.Create('Unable to encode data');

            inc(nRead,FInBufSize);
            dec(nBytes,FInBufSize);

            if (nEncoded > 0) then
            begin
               if not _WriteFile(FOutBuffer,nEncoded) then
               begin
                  Closed;
                  exit;
               end;
            end;
         end;

         if (nBytes > 0) then
         begin
            Move((lpwh^.lpData+nRead)^,FInBuffer^,nBytes);
            FBytesQueued := nBytes;
         end;
      end;
   end;

   inherited BufferReady(lpwh);
end;

procedure InitDriveSpacePtr;
var
  Kernel: THandle;
begin
  Kernel := GetModuleHandle(Windows.Kernel32);
  if Kernel <> 0 then
     @_GetDiskFreeSpaceEx := GetProcAddress(Kernel, 'GetDiskFreeSpaceExA');

  if not Assigned(_GetDiskFreeSpaceEx) then
     _GetDiskFreeSpaceEx := @BackfillGetDiskFreeSpaceEx;
end;

initialization
   InitDriveSpacePtr;
end.